home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PRUS101
/
FFILES.INC
< prev
next >
Wrap
Text File
|
1994-12-19
|
8KB
|
265 lines
{ FFILES.INC - include file for the PRUSSG unit FDOS to speed up and enhance
file related operations under DOS / implementation part }
(***************************************************************************
RELEASE 1.01 - as first contained in the file PRUS101.LZH
by Peter Schuette, 2:2452/117.19, GERMANY
--------------------------------------------
organized for Fido's PASCAL related echoes
--------------------------------------------
08/12/1994 to 09/05/1994 by Orazio Czerwenka, 2:2450/540.55, GERMANY
09/06/1994 to --/--/---- by Peter Schuette, 2:2452/117.19, GERMANY
As far as third party copyrights are not violated this
source code is hereby placed to the public domain. Use
it whatever way you want, but use AT YOUR OWN RISK.
In case you should modify the source rather send your
modifications to the unit's current organizer (see above for
NM address) than to spread it on your own. This will help to
keep the unit updated and grant a certain standard to all
other users as well.
The unit is currently still under work. So it might greatly
benefit of your participation.
Those who contributed to the following piece of source,
listed in alphabethical order:
================================================================
Orazio Czerwenka, Horst Kraemer, Wilbert van Leijen,
Sieghard Schicktanz, Peter Schuette ...
================================================================
YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
Credits in your own programs are as welcome as unnecessary.
***************************************************************************)
{ ----- VARs and CONSTs for FILEONPATH ------------------------------------- }
VAR
searchCOM: boolean;
DirEntry: SearchRec;
SearchName: PathStr;
SearchPath: DirStr;
DOSpath: string;
CONST
foundPrevious: boolean = false;
ProgExt: ARRAY [boolean] OF ExtStr = ('.EXE', '.COM');
{ -------------------------------------------------------------------------- }
function FileExists(FileName:PathStr):boolean;
{ Original author: Wilbert van Leijen,
modified according to proposals
of Horst Kraemer }
begin
FileName[Length(FileName)+1]:=#0;
{ the compiler adds #0 faster than BASM does,
have a look on your debugger; Horst Kraemer }
asm
push ds
push ss
pop ds
lea dx,filename[1]
mov ax,4300h
int 21h
mov @result,false
jc @1
inc @result
@1: pop ds
end
end;
{ -------------------------------------------------------------------------- }
FUNCTION FirstFile (SearchPath: PathStr): boolean;
BEGIN (* FirstFile *)
FindFirst (SearchPath, SearchFileAttr, DirEntry);
FirstFile:= DosError = 0;
END (* FirstFile *);
FUNCTION anotherFile: boolean;
BEGIN (* anotherFile *)
FindNext (DirEntry);
anotherFile:= DosError = 0;
END (* anotherFile *);
FUNCTION nextDir (VAR DOSpath: string): DirStr;
VAR
sc: byte;
BEGIN (* nextDir *)
sc:= Pos (';', DOSpath);
IF sc <> 0 THEN BEGIN
nextDir:= FExpand (Copy (DOSpath, 1, pred (sc)));
Delete (DOSpath, 1, sc);
END (* IF sc <> 0 *)
ELSE BEGIN
nextDir:= FExpand (DOSpath);
DOSpath:= '';
END (* ELSE *);
END (* nextDir *);
FUNCTION FileOnPath (FileSpec: PathStr; PathVariable: String;
prime: boolean): PathStr;
VAR
Ext: ExtStr;
PROCEDURE getDOSpath;
BEGIN (* getDOSpath *)
IF PathVariable = '' THEN PathVariable:= 'PATH';
DOSpath:= GetEnv (PathVariable);
SearchPath:= FExpand ('.');
SearchPath:= EnsureBackslash (SearchPath);
END (* getDOSpath *);
PROCEDURE searchDOSpath;
BEGIN (* searchDOSpath *)
REPEAT (* UNTIL prime *)
IF (NOT searchCOM) AND (DOSpath = '') THEN BEGIN
IF anotherFile
THEN FileOnPath:= SearchPath+ DirEntry.Name
ELSE BEGIN
FileOnPath:= ''; foundPrevious:= false;
END (* ELSE *);
prime:= true;
END (* IF NOT searchCOM AND (DOSpath = '') *)
ELSE BEGIN
SearchPath:= nextDir (DOSpath);
SearchPath:= EnsureBackslash (SearchPath);
prime:= FirstFile (SearchPath+ SearchName);
IF prime
THEN FileOnPath:= SearchPath+ DirEntry.Name
ELSE IF searchCOM AND (DOSpath = '') THEN BEGIN
searchCOM:= false;
SearchName:= Copy (SearchName, 1, Length (SearchName)- 4)+
ProgExt [false];
getDOSpath;
prime:= FirstFile (SearchPath+ SearchName);
IF prime THEN FileOnPath:= SearchPath+ DirEntry.Name;
END (* IF searchCOM AND (DOSpath = '') *);
END (* ELSE *);
UNTIL prime;
END (* searchDOSpath *);
BEGIN (* FileOnPath *)
IF prime THEN foundPrevious:= false;
IF foundPrevious THEN BEGIN
IF anotherFile THEN BEGIN
FileOnPath:= SearchPath+ DirEntry.Name;
END (* IF anotherFile *)
ELSE searchDOSpath;
END (* IF foundPrevious *)
ELSE BEGIN
{$V-}
FSplit (FileSpec, SearchPath, SearchName, Ext);
{$V+}
IF SearchName = '' THEN SearchName:= '*';
IF Ext = '' THEN BEGIN
searchCOM:= true;
Ext:= ProgExt [true];
END (* IF Ext = '' *);
SearchName:= SearchName+ Ext;
IF SearchPath = ''
THEN getDOSpath
ELSE BEGIN
SearchPath:= FExpand (SearchPath);
DOSpath:= '';
END (* ELSE *);
foundPrevious:= true;
IF FirstFile (SearchPath+ SearchName)
THEN FileOnPath:= SearchPath+ DirEntry.Name
ELSE searchDOSpath;
END (* ELSE *);
END (* FileOnPath *);
{ -------------------------------------------------------------------------- }
Function DelFile;
{ Mailed in by Peter Schuette }
VAr R: Registers;
Begin {DelFile}
{append #0 to filename to make it ASCIIZ}
FileName[Length(FileName)+1] := #0;
R.AH := $41;
R.DS := Seg(FileName);
R.DX := Ofs(FileName)+1;
Intr($21, R);
If (R.Flags and FCarry) <> 0 Then DelFile := R.AX
Else DelFile := 0;
End; {DelFile}
{ -------------------------------------------------------------------------- }
function RenFile;
{ Mailed in by Peter Schuette }
Var R: Registers;
Begin {RenFile}
OldName[Length(OldName)+1] := #0;
NewName[Length(NewName)+1] := #0;
R.AH := $56;
R.DS := Seg(OldName);
R.DX := Ofs(OldName)+1;
R.ES := Seg(NewName);
R.DI := Ofs(NewName)+1;
Intr($21, R);
If (R.Flags and FCarry) <> 0 Then RenFile := R.AX
Else RenFile := 0;
End; {RenFile}
{ --------------------------------------------------------------------------
Änderungen:
===========
in 1.00:
--------
12.08.1994 -ocz FileExist, RenFile und DelFile aus FDOS in FFILES
ausgelagert.
-ocz FileExist umbenannt in FileExists (=Korrektur eines
Tipfehlers :->).
-ocz *** NEU! *** Sieghard Schicktanzs OnPath als FileOnPath
aufgenommen.
Typendeklaration VarString = string[20] aufgegeben, da die
Umgebungsvariable PATH ab DOS 5.0 mit Tricks die doppelte
Länge eines ComStr annehmen können soll. Das wären
(theoretisch) bis zu 2x127 = 254 Zeichen. Den Typen VarString
also der Einfachheit halber durch den vordefinierten Typen
String ersetzt.
FileOnPath's FileExists umbenannt in FirstFile. Es kann nicht
durch die bereits vorhandene ASM-Variante ersetzt werden, da
es den von FileOnPath benötigten SearchRec mittels FindFirst
initialisieren muß, damit die Routine funktioniert.
Die Konstante DataFiles wurde zur flexibleren Handhabung im
Interface-Teil über FFILES.DEC als typisierte Konstante
SearchFileAttr exportiert.
Die Prozedur w_Backslash wurde zur Vermeidung doppelter
Routinen in den Projekt-Units durch die Funktion EnsureBack-
Slash aus FSTR ersetzt.
-------------------------------------------------------------------------- }